perm filename ANTS.WEB[304,DEK] blob
sn#867492 filedate 1988-12-31 generic text, type C, neo UTF8
COMMENT ⊗ VALID 00011 PAGES
C REC PAGE DESCRIPTION
C00001 00001
C00002 00002 % This program by D. E. Knuth is not copyrighted and can be used freely.
C00004 00003 @* Introduction.
C00010 00004 @* Random numbers.
C00013 00005 @* The character set.
C00018 00006 @* Basic input.
C00025 00007 @* Reading the ant data.
C00030 00008 @* The playing field.
C00037 00009 @* Moves.
C00044 00010 @* The main program.
C00047 00011 @* Index.
C00058 ENDMK
C⊗;
% This program by D. E. Knuth is not copyrighted and can be used freely.
% Here is TeX material that gets inserted after \input webmac
\def\title{ANTS}
\magnify{\magstep1}
%\pagewidth=4.2truein % estimate to match CACM line length
\setpage
%\tolerance=1000
\font\tenlogo=logo10 % font used for the METAFONT logo
\def\MF{{\tenlogo META}\-{\tenlogo FONT}}
%\advance\topskip by \baselineskip % doublespacing
%\advance\smallskipamount by \baselineskip
%\advance\baselineskip by \baselineskip
@* Introduction.
[This short program tries out the specs of the antomata problem. I~haven't
taken time to polish it at all; much of the code isn't really necessary!]
@ Here are some macros I may use for terminal I/O.
@d read_terminal(#)==read(tty,#) {input a value from the terminal}
@d print(#)==write(tty,#) {output to the terminal}
@d print_ln(#)==write_ln(tty,#) {output to the terminal and end the line}
@ Here's an outline of the entire Pascal program:
@p @t\4@>@<Compiler directives@>@/
program ants;
label @<Labels in the outer block@>@/
const @<Constants in the outer block@>@/
type @<Types in the outer block@>@/
var@?@<Global variables@>@/
@#
procedure initialize; {this procedure gets things started properly}
var @!i:integer; {all-purpose index for initialization}
begin @<Set initial values@>@;
end;@#
@t\2\4@>@<Random procedures@>@;
@<I/O procedures@>@;
@<Special procedures@>@;
begin initialize; @<The main program@>;
end.
@ Blah blah about constants.
@<Constants in the outer block@>=
buf_size=80; {maximum line length}
max_m=10; {maximum number of rows, plus~1}
max_n=21; {maximum number of columns, plus~1}
@ The only label needed in the main program is |final_end|.
@d final_end=9999 {this label marks the ending of the program}
@<Labels in the out...@>=
final_end;
@ If the first character of a Pascal comment is a dollar sign, the
compiler used here treats the comment as a list of ``compiler directives''
that will affect the translation of this program into machine language.
@<Compiler directives@>=
@{@&$C+,A+,D+@} {yes range check, catch arithmetic overflow, yes debug overhead}
@ We assume that |case| statements may include a
default case that applies if no matching label is found.
@d othercases == others: {default for cases not listed explicitly}
@d endcases == @+end {follows the default case in an extended |case| statement}
@f othercases == else
@f endcases == end
@ Labels are given symbolic names by the following definitions, copied from
the program for \TeX. This program doesn't actually use all the conventions
defined here; they are provided just to make changes easier.
@d exit=10 {go here to leave a procedure}
@d restart=20 {go here to start a procedure again}
@d reswitch=21 {go here to start a case statement again}
@d continue=22 {go here to resume a loop}
@d done=30 {go here to exit a loop}
@d done1=31 {like |done|, when there is more than one loop}
@d done2=32 {for exiting the second loop in a long block}
@d done3=33 {for exiting the third loop in a very long block}
@d done4=34 {for exiting the fourth loop in an extremely long block}
@d done5=35 {for exiting the fifth loop in an immense block}
@d done6=36 {for exiting the sixth loop in a block}
@d found=40 {go here when you've found it}
@d found1=41 {like |found|, when there's more than one per routine}
@d found2=42 {like |found|, when there's more than two per routine}
@d not_found=45 {go here when you've found nothing}
@d common_ending=50 {go here when you want to merge with another branch}
@ Here are some macros for common programming idioms.
@d incr(#) == #←#+1 {increase a variable by unity}
@d decr(#) == #←#-1 {decrease a variable by unity}
@d negate(#) == #←-# {change the sign of a variable}
@d loop == @+ while true do@+ {repeat over and over until a |goto| happens}
@f loop == xclause
{\.{WEB}'s |xclause| acts like `\ignorespaces|while true do|\unskip'}
@d do_nothing == {empty statement}
@d return == goto exit {terminate a procedure call}
@f return == nil
@* Random numbers.
Here are some procedures for random number generation copied from
\MF\ with minor changes.
There's an auxiliary array |randoms| that contains 55 pseudo-random
fractions. Using the recurrence $x_n=(x_{n-55}-x_{n-31})\bmod \\{rbase}$,
we generate batches of 55 new $x_n$'s at a time by calling |new_randoms|.
The global variable |j_random| tells which element has most recently
been consumed.
@d rbase==1000000000 {range of random numbers}
@d half_rbase==500000000
@<Glob...@>=
@!randoms:array[0..54] of 0..rbase-1; {the last 55 random values generated}
@!j_random:0..54; {the number of unused |randoms|}
@ To consume a random bit, the program below will say `|if| |random_bit|'.
The following macro is tricky, hence not very robust:
@d random_bit==j_random=0 then new_randoms
else decr(j_random);
if randoms[j_random]<half_rbase
@<Random...@>=
procedure new_randoms;
var @!k:0..54; {index into |randoms|}
@!x:integer; {accumulator}
begin for k←0 to 23 do
begin x←randoms[k]-randoms[k+31];
if x<0 then x←x+rbase;
randoms[k]←x;
end;
for k←24 to 54 do
begin x←randoms[k]-randoms[k-24];
if x<0 then x←x+rbase;
randoms[k]←x;
end;
j_random←54;
end;
@ To initialize the |randoms| table, we call the following routine.
@<Random...@>=
procedure init_randoms(@!seed:integer);
var @!j,@!jj,@!k:integer; {more or less random integers}
@!i:0..54; {index into |randoms|}
begin j←abs(seed);
while j≥rbase do j←j div 2;
k←1;
for i←0 to 54 do
begin jj←k; k←j-k; j←jj;
if k<0 then k←k+rbase;
randoms[(i*21)mod 55]←j;
end;
new_randoms; new_randoms; new_randoms; {``warm up'' the array}
end;
@* The character set.
We need translation tables between ASCII and the actual character
set, in order to make this program portable. The standard conventions of
{\sl \TeX: The Program\/} are copied here, essentially verbatim.
@d text_char == char {the data type of characters in text files}
@d first_text_char=0 {ordinal number of the smallest element of |text_char|}
@d last_text_char=127 {ordinal number of the largest element of |text_char|}
@<Types...@>=
@!ASCII_code=0..127; {seven-bit numbers}
@ @<Glob...@>=
@!xord: array [text_char] of ASCII_code;
{specifies conversion of input characters}
@!xchr: array [ASCII_code] of text_char;
{specifies conversion of output characters}
@ @<Set init...@>=
xchr[@'40]←' ';
xchr[@'41]←'!';
xchr[@'42]←'"';
xchr[@'43]←'#';
xchr[@'44]←'$';
xchr[@'45]←'%';
xchr[@'46]←'&';
xchr[@'47]←'''';@/
xchr[@'50]←'(';
xchr[@'51]←')';
xchr[@'52]←'*';
xchr[@'53]←'+';
xchr[@'54]←',';
xchr[@'55]←'-';
xchr[@'56]←'.';
xchr[@'57]←'/';@/
xchr[@'60]←'0';
xchr[@'61]←'1';
xchr[@'62]←'2';
xchr[@'63]←'3';
xchr[@'64]←'4';
xchr[@'65]←'5';
xchr[@'66]←'6';
xchr[@'67]←'7';@/
xchr[@'70]←'8';
xchr[@'71]←'9';
xchr[@'72]←':';
xchr[@'73]←';';
xchr[@'74]←'<';
xchr[@'75]←'=';
xchr[@'76]←'>';
xchr[@'77]←'?';@/
xchr[@'100]←'@@';
xchr[@'101]←'A';
xchr[@'102]←'B';
xchr[@'103]←'C';
xchr[@'104]←'D';
xchr[@'105]←'E';
xchr[@'106]←'F';
xchr[@'107]←'G';@/
xchr[@'110]←'H';
xchr[@'111]←'I';
xchr[@'112]←'J';
xchr[@'113]←'K';
xchr[@'114]←'L';
xchr[@'115]←'M';
xchr[@'116]←'N';
xchr[@'117]←'O';@/
xchr[@'120]←'P';
xchr[@'121]←'Q';
xchr[@'122]←'R';
xchr[@'123]←'S';
xchr[@'124]←'T';
xchr[@'125]←'U';
xchr[@'126]←'V';
xchr[@'127]←'W';@/
xchr[@'130]←'X';
xchr[@'131]←'Y';
xchr[@'132]←'Z';
xchr[@'133]←'[';
xchr[@'134]←'\';
xchr[@'135]←']';
xchr[@'136]←'↑';
xchr[@'137]←'_';@/
xchr[@'140]←'`';
xchr[@'141]←'a';
xchr[@'142]←'b';
xchr[@'143]←'c';
xchr[@'144]←'d';
xchr[@'145]←'e';
xchr[@'146]←'f';
xchr[@'147]←'g';@/
xchr[@'150]←'h';
xchr[@'151]←'i';
xchr[@'152]←'j';
xchr[@'153]←'k';
xchr[@'154]←'l';
xchr[@'155]←'m';
xchr[@'156]←'n';
xchr[@'157]←'o';@/
xchr[@'160]←'p';
xchr[@'161]←'q';
xchr[@'162]←'r';
xchr[@'163]←'s';
xchr[@'164]←'t';
xchr[@'165]←'u';
xchr[@'166]←'v';
xchr[@'167]←'w';@/
xchr[@'170]←'x';
xchr[@'171]←'y';
xchr[@'172]←'z';
xchr[@'173]←'{';
xchr[@'174]←'|';
xchr[@'175]←'}';
xchr[@'176]←'~';@/
xchr[0]←' '; xchr[@'177]←' ';
{ASCII codes 0 and |@'177| do not appear in text}
@ Some of the ASCII codes without visible characters have been given symbolic
names in this program because they are used with a special meaning.
@d null_code=@'0 {ASCII code that might disappear}
@d carriage_return=@'15 {ASCII code used at end of line}
@d invalid_code=@'177 {ASCII code that should not appear}
@<Set init...@>=
for i←1 to @'37 do xchr[i]←chr(i);
for i←first_text_char to last_text_char do xord[chr(i)]←invalid_code;
for i←1 to @'176 do xord[xchr[i]]←i;
@* Basic input.
Input goes into an array called |buffer|, in a machine-independent form.
If anything goes wrong during an input process, the variable |input_awry|
is set |true| and an error message is printed.
@<Glob...@>=
@!buffer: array[0..buf_size] of ASCII_code; {the current line of input}
@!input_awry: boolean; {has something gone wrong?}
@ Values are read from the buffer by various scanning routines
whose names begin with `\\{get}'. They use the global variable |loc|
to find the current buffer position, as well as the global variable |limit|
which is the smallest unused buffer location.
@<Glob...@>=
@!loc:0..buf_size; {the next character to read is in |buffer[loc]|}
@!limit:0..buf_size; {but if |loc=limit|, the line has been fully read}
@ @<Set init...@>=
input_awry←false; loc←0; limit←0;
@ Here's a procedure that shows the current buffer contents,
using two lines to indicate how many of the characters have been scanned.
It is used only in error messages.
@d input_err(#)==begin print_ln(#,'!'); print_buf; input_awry←true;@+end
@<I/O procedures@>=
procedure print_buf;
var @!k:0..buf_size;
begin if loc>0 then for k←0 to loc-1 do print(xchr[buffer[k]]);
print_ln('');
if loc>0 then for k←0 to loc-1 do print(' ');
if loc<limit then for k←loc to limit-1 do print(xchr[buffer[k]]);
print_ln('');
end;
@ Files are assumed to consist of text only.
@<Types...@>=
@!text_file=packed file of text_char;
@ Input data will be read from |data_file|, which we assume can be
opened by specifying the file name dynamically.
@↑system dependencies@>
@d open_data_file(#)==reset(data_file,#)
@<Glob...@>=
@!data_file:text_file;
@ When all input has been performed on |data_file|, we call `|close_data_file|',
a routine that releases the file for use by others (if our version of
Pascal allows this).
@↑system dependencies@>
@d close_data_file==close(data_file)
@ The |input_ln| procedure brings the next line of input from the
specified file into the |buffer| array. The conventions of \TeX\ are
followed; i.e., |ASCII_code| numbers representing the next line of the
file are input into |buffer[0]|, |buffer[1]|, \dots, |buffer[limit-1]|, and
trailing blanks are ignored. The global variable |limit| is set to the
length of the line, and |loc| is cleared to zero.
The character `\.?' is placed at the end of the line, in case some
scanning routine fetches |buffer[loc]|.
The file should not have ended when |input_ln| is called.
@↑system dependencies@>
@<I/O procedures@>=
procedure input_ln(var@!f:text_file;@!bypass_eoln:boolean); {inputs a line}
var @!final_limit:0..buf_size; {|limit| without trailing blanks}
begin if bypass_eoln then if not eof(f) then get(f);
if eof(f) then input_err('Unexpected end of file')
@.Unexpected end of file@>
else begin limit←0; final_limit←0; loc←0;
while not eoln(f) do
begin buffer[limit]←xord[f↑]; get(f);
incr(limit);
if buffer[limit-1]≠" " then final_limit←limit;
if limit=buf_size then
begin input_err('Input line too long');
@.Input line too long@>
while not eoln(f) do get(f);
end;
end;
limit←final_limit; buffer[limit]←"?";
end;
end;
@ Here's the simplest scanning routine: It returns a single character,
in ASCII code.
@<I/O proc...@>+=
function get_char:ASCII_code;
var @!c:ASCII_code; {the character to return}
begin c←buffer[loc];
if loc<limit then incr(loc)@+else input_err('Input line too short');
@.Input line too short@>
get_char←c;
end;
@ The next simplest scanning routine returns an integer value.
@<I/O proc...@>=
function get_int:integer;
var @!x:integer; {the number to return}
@!loc0:0..buf_size; {initial |loc| setting}
begin loc0←loc; x←0;
while (buffer[loc]≥"0")∧(buffer[loc]≤"9") do
begin x←10*x+buffer[loc]-"0"; incr(loc);
end;
if loc=loc0 then input_err('Missing integer');
@.Missing integer@>
get_int←x;
end;
@ Then there's |get_hex|.
@<I/O proc...@>=
function get_hex:integer;
label not_found,exit;
var @!x:integer;
begin x←get_char;
if x<"0" then goto not_found;
if x≤"9" then x←x-"0"
else begin if x<"A" then goto not_found;
if x≤"F" then x←x-"A"+10
else begin if x<"a" then goto not_found;
if x>"f" then goto not_found;
x←x-"a"+10;
end;
end;
get_hex←x; return;
not_found: input_err('Bad hex digit'); get_hex←0;
exit: end;
@* Reading the ant data.
The instructions are kept in four arrays |template|, |mask|, |action|,
|next|; their symbolic names go in |symb1..symb4|.
Scent codes go into |scent_code|. The input format is very primitive.
@<Glob...@>=
@!symb1,@!symb2,@!symb3,@!symb4:array[0..1024] of ASCII_code;
@!template,@!mask:array[0..1024] of set of inputs;
@!action:array[0..1024] of set of acts;
@!next:array[0..1024] of 0..1023;
@!scent_code:array[0..15] of ASCII_code;
@ @<Types...@>=
@!inputs=(@!ant,@!barrier,@!food,@!rand,@!s1,@!s2,@!s3,@!s4);
@!acts=(@!ds1,@!ds2,@!ds3,@!ds4,@!mm,@!pp);
@ @<Clear the instructions to zero@>=
for i←0 to 1024 do
begin symb1[i]←" "; symb2[i]←" "; symb3[i]←" "; symb4[i]←" ";
template[i]←[]; mask[i]←[]; action[i]←[]; next[i]←0;
end
@ Most of the input consists of individual instruction lines.
@<I/O...@>=
procedure get_inst(i:integer);
label exit;
var x,y:integer;
t:inputs;
a:acts;
begin @<Read the template part of a line@>;
if input_awry then return;
@<Read the action part of a line@>;
if input_awry then return;
if loc<limit then x←get_char;
if loc<limit then symb1[i]←get_char else symb1[i]←" ";
if loc<limit then symb2[i]←get_char else symb2[i]←" ";
if loc<limit then symb3[i]←get_char else symb3[i]←" ";
if loc<limit then symb4[i]←get_char else symb4[i]←" ";
exit:end;
@ @<Read the template part of a line@>=
x←get_hex*16+get_hex; y←get_hex*16+get_hex;
for t←s4 downto ant do
begin if odd(x) then template[i]←template[i]+[t];
if odd(y) then mask[i]←mask[i]+[t];
x←x div 2; y←y div 2;
end
@ @<Read the action part of a line@>=
x←get_hex*16+get_hex; next[i]←((x mod 4)*16+get_hex)*16+get_hex;
x←x div 4;
for a←pp downto ds1 do
begin if odd(x) then action[i]←action[i]+[a];
x←x div 2;
end
@ The function |read_ant| returns |false| if any anomaly is detected.
@<I/O...@>=
function read_ant:boolean;
label not_found,found,exit;
var i:integer;
begin open_data_file('ANT.DAT');
input_ln(data_file,false);
input_ln(data_file,true); {ignore the first (name) line}
for i←0 to 15 do if not input_awry then scent_code[i]←get_char;
if input_awry then goto not_found;
@<Clear the instructions to zero@>;
i←0;
loop begin input_ln(data_file,true);
if input_awry then goto not_found;
if buffer[0]="*" then goto found;
get_inst(i); incr(i);
if input_awry then goto not_found;
end;
found: read_ant←true; return;
not_found: read_ant←false;
exit:close_data_file;
end;
@* The playing field.
The ants can move in an $m\times n$ field surrounded by barriers, where
|m<max_m| and |n<max_n|.
Each cell of the field is represented by several array entries.
@d up_ant=0 {code for ant facing up}
@d left_ant=1 {code for ant facing left}
@d down_ant=2 {code for ant facing down}
@d right_ant=3 {code for ant facing right}
@d empty=4 {code for empty cell}
@d barr=5 {code for barrier cell}
@d nest=10 {code for food units in a nest cell}
@<Glob...@>=
@!cell_type:array[0..max_m,0..max_n] of 0..5; {contents of cell}
@!cell_loc:array[0..max_m,0..max_n] of integer; {ant state}
@!ant_full:array[0..max_m,0..max_n] of boolean; {does the ant carry food?}
@!cell_food:array[0..max_m,0..max_n] of 0..nest; {number of food bits}
@!cell_scent:array[0..max_m,0..max_n] of set of inputs; {scent of cell}
@!init_cell_food:array[0..max_m,0..max_n] of 0..nest; {initial number of food bits}
@!m,@!n:integer; {size of field}
@!tot_food:integer; {number of bits of food outside the nest}
@!seed:integer; {initial value for the random number generator}
@ We read the initial board thus:
@<I/O...@>=
function read_board:boolean;
label not_found,found,exit;
var i,j:integer;
begin open_data_file('FIELD.DAT');
input_ln(data_file,false);
m←get_int;
if m≥max_m then input_err('m too large');
if get_char≠" " then input_err('Missing blank')
else begin n←get_int; if n≥max_n then input_err('n too large');
end;
if input_awry then goto not_found;
@<Put a barrier around the field@>;
for i←1 to m do
begin input_ln(data_file,true);
if input_awry then goto not_found;
for j←1 to n do case get_char of
".":begin cell_type[i,j]←empty; init_cell_food[i,j]←0; cell_loc[i,j]←0;
end;
"1","2","3","4","5","6","7","8","9":begin cell_type[i,j]←empty;
init_cell_food[i,j]←buffer[loc-1]-"0";
end;
"B":begin cell_type[i,j]←barr;init_cell_food[i,j]←0;
end;
"N":begin cell_type[i,j]←up_ant; init_cell_food[i,j]←nest;
cell_loc[i,j]←0;
end;
othercases input_err('Unknown field code')
endcases;
if input_awry then goto not_found;
end;
found: read_board←true; return;
not_found: read_board←false;
exit:close_data_file;
end;
@ @<Put a barrier around the field@>=
for i←1 to m do
begin cell_type[i,0]←barr; cell_food[i,0]←0;
cell_type[i,n+1]←barr; cell_food[i,n+1]←0;
end;
for j←1 to n do
begin cell_type[0,j]←barr; cell_food[0,j]←0;
cell_type[m+1,j]←barr; cell_food[m+1,j]←0;
end
@ The board is actually initialized as follows:
@<Special...@>=
procedure init_board;
var i,j:integer;
begin tot_food←0; init_randoms(seed);
for i←1 to m do for j←1 to n do
begin cell_food[i,j]←init_cell_food[i,j];
if cell_food[i,j]>9 then
begin cell_type[i,j]←up_ant; cell_loc[i,j]←0;
end
else if cell_type[i,j]<barr then
begin cell_type[i,j]←empty; tot_food←tot_food+cell_food[i,j];
end;
ant_full[i,j]←false; cell_scent[i,j]←[]; move_loc[i,j]←0;
end;
end;
@ Here's a procedure that will display the current board.
@<Special...@>=
procedure print_board;
label done;
var i,j,l,sc:integer;
begin for i←1 to m do
begin for j←1 to n do @<Print first line for |cell[i,j]|@>;
print_ln('');
if time<50 then
begin for j←1 to n do @<Print second line for |cell[i,j]|@>;
print_ln('');
end;
end;
end;
@ @<Print first...@>=
begin if ant_full[i,j] then print('⊗')@+ else print(' ');
case cell_type[i,j] of
up_ant: print('↑');
left_ant: print('←');
down_ant: print('↓');
right_ant: print('→');
empty: print('.');
barr: begin print('BBB'); goto done;
end;
endcases;
@<Print the scent of |cell[i,j]|@>;
if cell_food[i,j]=0 then print('.')
else if cell_food[i,j]>9 then print('∞')
else print(cell_food[i,j]:1);
done:end
@ @<Print the scent of |cell[i,j]|@>=
if s1 in cell_scent[i,j] then sc←8@+else sc←0;
if s2 in cell_scent[i,j] then sc←sc+4;
if s3 in cell_scent[i,j] then sc←sc+2;
if s4 in cell_scent[i,j] then sc←sc+1;
print(xchr[scent_code[sc]])
@ @<Print second...@>=
case cell_type[i,j] of
up_ant,left_ant,down_ant,right_ant:begin l←cell_loc[i,j];
print(xchr[symb1[l]]);
print(xchr[symb2[l]]);
print(xchr[symb3[l]]);
print(xchr[symb4[l]]);
end;
empty:print(' ...');
barr: print(' BBB');
endcases
@* Moves.
The main action at each unit of time is defined by the |move| routine.
@<Special...@>=
procedure move;
label done,continue,not_found;
var@!i,@!ii,@,j,@!jj,@!l:integer;
@!s:inputs;
@!t,@!tt:set of inputs;
@!ds:acts;
@!p:integer; {top of stack of logged moves}
@!q:integer; {packed version of |[ii,jj]|}
begin p←0;
for i←1 to m do for j←1 to n do if cell_type[i,j]<empty then
begin @<Compute the input bits@>;
@<Find the matching instruction@>;
@<Do or log the specified action@>;
end;
@<Do all logged moves@>;
end;
@ Moves are ``logged'' (to be done later) by putting |max_n*i+j| in
|move_loc[ii,jj]| when we wish to move from |[i,j]| to |[ii,jj]|. A pointer
to another logged move, if any, goes in |move_link[ii,jj]|.
@<Glob...@>=
@!move_loc:array[0..max_m,0..max_n] of integer; {I'll move from here}
@!move_link:array[0..max_m,0..max_n] of integer; {stack link}
@ @<Compute the input bits@>=
case cell_type[i,j] of
up_ant: begin ii←i-1; jj←j;@+end;
left_ant: begin ii←i; jj←j-1;@+end;
right_ant: begin ii←i; jj←j+1;@+end;
down_ant: begin ii←i+1; jj←j;@+end;
endcases;
if cell_food[ii,jj]>0 then t←[food]@+else t←[];
case cell_type[ii,jj] of
up_ant,left_ant,right_ant,down_ant:begin t←t+[ant];
if ant_full[ii,jj] then t←t+[barrier];
end;
empty:do_nothing;
barr:t←t+[barrier];
endcases;
if random_bit then t←t+[rand];
if cell_food[ii,jj]<nest then for s←s1 to s4 do
if s in cell_scent[ii,jj] then t←t+[s]
@ @<Find the matching instruction@>=
l←cell_loc[i,j];
loop begin tt←(t-template[l])+(template[l]-t);
if tt*mask[l]=[] then goto done;
incr(l);
end;
done:
@ @d delta(#)==if d@ in action[l] then
begin if # in cell_scent[i,j] then cell_scent[i,j]←cell_scent[i,j]-[#]
else cell_scent[i,j]←cell_scent[i,j]+[#];
end
@<Do or log the specified action@>=
if mm in action[l] then
if pp in action[l] then @<Log a move and |goto continue|@>
else cell_type[i,j]←(cell_type[i,j]+1) mod 4 {left turn}
else if pp in action[l] then cell_type[i,j]←(cell_type[i,j]+3) mod 4; {right turn}
delta(s1); delta(s2); delta(s3); delta(s4);
cell_loc[i,j]←next[l];
continue:
@ @<Log...@>=
begin if cell_type[ii,jj]≠empty then if cell_food[ii,jj]<nest then goto not_found;
if move_loc[ii,jj]>0 then goto not_found;
move_loc[ii,jj]←i*max_n+j; move_link[ii,jj]←p;
p←ii*max_n+jj; cell_loc[i,j]←l;
goto continue;
not_found: if next[l]=0 then cell_loc[i,j]←1024@+else cell_loc[i,j]←next[l]-1;
goto continue;
end
@ @<Do all logged moves@>=
while p>0 do
begin ii←p div max_n; jj←p mod max_n;@/
i←move_loc[ii,jj] div max_n; j←move_loc[ii,jj] mod max_n;@/
l←cell_loc[i,j]; @<Update cell |ii,jj|@>;
if cell_food[i,j]<nest then
begin cell_type[i,j]←empty; ant_full[i,j]←false;
end
else begin cell_type[i,j]←up_ant; cell_loc[i,j]←0;
end;
p←move_link[ii,jj]; move_loc[ii,jj]←0;
end
@ @d ddelta(#)==if d@ in action[l] then
begin if # in cell_scent[ii,jj] then cell_scent[ii,jj]←cell_scent[ii,jj]-[#]
else cell_scent[ii,jj]←cell_scent[ii,jj]+[#];
end
@<Update cell...@>=
begin ddelta(s1); ddelta(s2); ddelta(s3); ddelta(s4);
if cell_food[ii,jj]=nest then
begin if ant_full[i,j] then tot_food←tot_food-1;
end
else begin cell_type[ii,jj]←cell_type[i,j];
if ant_full[i,j] then ant_full[ii,jj]←true
else if cell_food[ii,jj]>0 then
begin ant_full[ii,jj]←true; decr(cell_food[ii,jj]);
end
else ant_full[ii,jj]←false;
cell_loc[ii,jj]←next[l];
end;
end
@* The main program.
(temporary, I keep hacking at this)
@<The main...@>=
seed←0;
if read_ant then if read_board then
loop begin incr(seed); time←0;
init_board; if seed=1 then print_board;
while tot_food>0 do
begin if seed=1 then
print_ln('**************************** time=',time:1,@|
' food remaining=',tot_food:1);@/
move; incr(time); if seed=1 then print_board;
end;
print_ln('======================================= time=',time:1);
end;
final_end:
@ @<Glob...@>=
@!time:integer;
@* Index.
Here are the quantities declared and/or used in the program.
(The uses of single-letter variables aren't indexed.)